Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/ISSUE05/EDSSPELL/EDSSPELL.ZIP/EDSSPELL.PAS

Pascal/Delphi Source File | 1995-11-30 | 12.1 KB | 391 lines

unit EDSSpell;
  {-Component Wrapper for Spell Dialog}

(*Revision History*)
(* 11/15/95 - Added call so that all words can be added on         *)
(*            unregistered version.                                *)
(* 11/28/95 - Added apostrophe to valid characters (oops)          *)
(* 11/30/95 - Added define for supporting the TDBMemos directly    *)

{.$DEFINE SupportDBMemos}  {-enable to support DBMemos}
   {-enabling this will require your application to use the BDE}
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, Menus, ExtCtrls,
  WSpell, SpellInt
{$IFDEF SupportDBMemos}
  ,DBCtrls;
{$ELSE}
  ;
{$ENDIF}

type
  {Dialog Component Wrapper}
  TSpellDlg = class (TComponent)
  private
    FPath:           TFileName;
    FDictionary:     TFileName;
    FDicType:        Languages;
    FSpellWin:       TSpellWin;
    FSuggestions:    Byte;
    FIcons:          AccentSet;
    FAutoSuggest:    Boolean;
    procedure   SetDicType (NewType: Languages);
      {-sets the new dictionary type}
    procedure   SetSuggestions (Num: Byte);
      {-sets the number of suggestions}
    procedure   SetIconSet (IconSet: AccentSet);
      {-sets the icons to be visible}
  public
    constructor Create (AOwner: TComponent); override;
      {-initializes object}
    destructor  Destroy;  override;
      {-destroys object}
    procedure   Open;
      {-opens the dictionary and displays dialog}
    procedure   Close;
      {-closes the dictionary and removes the dialog}
    function    CheckWord (AWord: String): String;
      {-checks the word}
    procedure   CheckMemo (AMemo: TMemo);
      {-checks the memo}
{$IFDEF SupportDBMemos}
    procedure   CheckDBMemo (ADBMemo: TDBMemo);
      {-checks a database memo}
{$ENDIF}

    {---- Internal Routines (No Dialog) ----}
    function    OpenDictionary: Boolean;
      {-opens the dictionary}
    procedure   CloseDictionary;
      {-closes the dictionary}
    function    InDictionary (AWord: String): Boolean;
      {-checks to see if the word is in the dictionary (no dialog)}
    function    SuggestWords (AWord: String; NumToList: Byte): TStringList;
      {-suggests words}
  published
    property AccentIcons:    AccentSet read FIcons write SetIconSet;
    property DictionaryPath: TFileName read FPath write FPath;
    property DictionaryName: TFileName read FDictionary write FDictionary;
    property DictionaryType: Languages read FDicType write SetDicType;
    property Suggestions:    Byte read FSuggestions write SetSuggestions;
    property AutoSuggest:    Boolean read FAutoSuggest write FAutoSuggest;
  end;  { TSpellDlg }

procedure Register;

implementation

{---- TSpellDlg.Wrapper ----}
constructor TSpellDlg.Create (AOwner: TComponent);
begin
  inherited Create (AOwner);
  FSpellWin   := TSpellWin.Create (Self);
  FDictionary := '';
  FPath       := 'ApplicationPath';
  Suggestions := 5;
end; { TSpellDlg.Create }

destructor TSpellDlg.Destroy;
begin
  FSpellWin.Destroy;
  inherited Destroy;
end;  { TSpellDlg.Destroy }

procedure TSpellDlg.SetDicType (NewType: Languages);
  {-sets the new dictionary type}
begin
  FDicType := NewType;
  with FSpellWin do
  begin
    case FDicType of
      lgSpanish: Include (FIcons, acSpanish);
    end;  { case }
  end;  { case }
end;  { TSpellDlg.SetDicType }

procedure TSpellDlg.SetSuggestions (Num: Byte);
begin
  if Num>10 then
  begin
    MessageDlg ('Maximum limit suggestions is 10.',
                mtInformation, [mbOk], 0);
    FSuggestions := 10;
  end {:} else
  if Num<1 then
  begin
    MessageDlg ('Invlid number of suggestions.',
                mtInformation, [mbOk], 0);
    FSuggestions := 1;
  end {:} else
    FSuggestions := Num;
  FSpellWin.NumToSuggest := FSuggestions;
end;  { TSpellDlg.SetSuggestions }

procedure TSpellDlg.SetIconSet (IconSet: AccentSet);
begin
  FIcons := IconSet;
  with FSpellWin do
  begin
    lstSuggest.Top    := 48;
    lstSuggest.Height := 161;
    pnlIcons.Visible  := FALSE;
    if acSpanish in FIcons then
    begin
      pnlIcons.Visible  := TRUE;
      lstSuggest.Top    := lstSuggest.Top + pnlIcons.Height;
      lstSuggest.Height := lstSuggest.Height - pnlIcons.Height;
    end;  { if... }
  end;  { with }
end;  { TSpellDlg.SetIconSet }

procedure TSpellDlg.Open;
  {-opens the dictionary and prepares dialog}
begin
  if not OpenDictionary then
  begin
    MessageDlg ('Error opening dictionary '+ FPath + FDictionary,
                mtError, [mbOk], 0);
    Close;
  end;  { if... }
end;  { TSpellDlg.Open }

procedure TSpellDlg.Close;
  {-closes the dictionary and removes the dialog}
begin
  FSpellWin.Close;
  CloseDictionary;
end;  { TSpellDlg.Close }

function TSpellDlg.CheckWord (AWord: String): String;
  {-checks the word}
var
  Perform: byte;
begin
  if not FSpellWin.Visible then
     Open ; {-open current dictionary}
  {Set up window}
  FSpellWin.Position            := poScreenCenter;
  FSpellWin.lblNotFound.Caption := AWord;
  FSpellWin.edtWord.Text        := AWord;
  FSpellWin.btnSkip.Enabled     := FALSE;
  FSpellWin.btnSkipAll.Enabled  := FALSE;
  if InDictionary (AWord) then
  begin
    FSpellWin.lblFound.Caption := 'Word found:';
  end {:} else
  begin
    FSpellWin.lblFound.Caption := 'Not found:';
  end;  { else }
  Perform := FSpellWin.ShowModal;
  if PerForm = 20 then Result := FSpellWin.edtWord.Text
                  else Result := '';
end;  { TSpellDlg.CheckWord }

procedure TSpellDlg.CheckMemo (AMemo: TMemo);
  {-checks the memo}
var
  WordSt:     string;   {current word}
  OemSt:      string;   {OEM version of string}
  CloseWin:   Boolean;  {TRUE if close window at end}
  Buffer:     PBigBuffer; {memo buffer}
  p:          pChar;    {pointer to current position in buffer}
  Size:       Longint;  {size of buffer}
  CurPos:     Longint;  {current position in buffer}
  BeginPos:   Longint;  {beginning position of current word}
  EndPos:     Longint;  {ending position of current word}
  sSelStart:  Longint;  {saves the current attributes of Memo}
  sSelLength: Longint;  { '' }
  sHideSel:   Boolean;  { '' }
  NoErrors:   Boolean;  {TRUE if all words are spelled correctly}
  WinResult:  Byte;     {Result from ShowModal call}
  SkipList:   TStringList;  {List of skipped words}
  WordAdded:  Boolean;  {TRUE if a word was added}

  function GetNextWord: string;
    {-returns the next word in the buffer}
  const
    ValidChars: Set Of Char =
      [#39{'}, 'a'..'z', 'A'..'Z', #130{Θ},
       #160{ß}..#165{╤}];
  var
    S: string;  {string being constructed}
  begin
    BeginPos := CurPos;
    EndPos   := CurPos;
    S        := '';
    {find the first letter of the next word}
    while (not (Char (p^) in ValidChars)) and
          (CurPos<Size) do
    begin
      Inc (CurPos, 1);
      p := @Buffer^[CurPos];
    end; {  while }
    if CurPos<Size then
    begin
      BeginPos := CurPos;
      {goto the end of the word}
      while ((Char (p^) in ValidChars) and
             (CurPos<Size)) do
      begin
        S := ConCat (S, Char (p^));
        Inc (CurPos, 1);
        p := @Buffer^[CurPos];
        EndPos := CurPos;
      end;  { while }
      Result := S;
    end {:} else
      Result := '';
  end;  { GetNextWord }

  procedure UpdateBuffer;
  begin
    Size := AMemo.GetTextLen + 1;
    AMemo.GetTextBuf (pChar(Buffer), Size);
    AnsiToOemBuff (pChar (Buffer), pChar (Buffer), Size);
  end;  { UpdateBuffer }

begin
  sSelStart           := AMemo.SelStart;
  sSelLength          := AMemo.SelLength;
  sHideSel            := AMemo.HideSelection;
  AMemo.HideSelection := FALSE;
  WordAdded           := FALSE;
  try
    SkipList := TStringList.Create;
    {FSpellWin.FormStyle := fsStayOnTop;}
    CloseWin            := FALSE;
    New (Buffer);
    UpdateBuffer;
    p      := @Buffer^[1];
    CurPos := 1;
    if not FSpellWin.Visible then
    begin
       Open ; {-open current dictionary}
       CloseWin := TRUE;
    end; {  if... }
    {Set up window}
    FSpellWin.Position            := poScreenCenter;
    FSpellWin.btnSkip.Enabled     := TRUE;
    FSpellWin.btnSkipAll.Enabled  := TRUE;
    with AMemo do
    begin
      {calculate the upper most bounds for the memo}
      {assume entire document for now}
      NoErrors := TRUE;
      repeat
        WordSt := GetNextWord;
        if not InDictionary (WordSt) then
        begin
          if SkipList.IndexOf (UpperCase (WordSt)) = (-1) then
          begin
            FSpellWin.lstSuggest.Clear;
            NoErrors        := FALSE;
            AMemo.SelStart  := BeginPos - 1;
            AMemo.SelLength := EndPos - BeginPos;
            AMemo.Update;
            FSpellWin.lblFound.Caption    := 'Not found:';
            FSpellWin.lblNotFound.Caption := WordSt;
            FSpellWin.edtWord.Text        := WordSt;
            if FAutoSuggest then
              FSpellWin.btnSuggestClick (nil);
            WinResult := FSpellWin.ShowModal;
            case WinResult of
              20: begin
                CurPos  := CurPos - (EndPos - BeginPos);
                AMemo.SelText := FSpellWin.edtWord.Text;
                CurPos  := CurPos + Length (FSpellWin.edtWord.Text);
                UpdateBuffer;
                p := @Buffer^[CurPos];
              end;  { Replace }
              21: begin
                    {Add to dictionary}
                    WordAdded := TRUE;
                  end;  { 21 }
              22: {SkipOnce};
              23: begin
                {add word to skiplist}
                WordSt := UpperCase (WordSt);
                SkipList.Add (WordSt);
              end;  { SkipAll }
              mrCancel: break;
            end;  { case }
          end;  { if... }
        end;  { if... }
      until WordSt='';
    end;  { with }
    if CloseWin then FSpellWin.Close;
    if WordAdded then dllCloseDictionary;
  finally
    SkipList.Free;
    Dispose (Buffer);
  end;  { try }
  if NoErrors then
    MessageDlg ('No errors found. Spell checking complete...', mtInformation,
                [mbOk], 0)
  else
  if WinResult=mrCancel then
    MessageDlg ('Spell checking aborted...', mtInformation,
                [mbOk], 0)
  else
    MessageDlg ('Spell checking complete...', mtInformation,
                [mbOk], 0);
  AMemo.SelStart      := sSelStart;
  AMemo.SelLength     := sSelLength;
  AMemo.HideSelection := sHideSel;
end;  { TSpellDlg.CheckMemo }

{$IFDEF SupportDBMemos}
procedure TSpellDlg.CheckDBMemo (ADBMemo: TDBMemo);
  {-checks a database memo}
begin
  CheckMemo (TMemo (ADBMemo));
end;  { TSpellDlg.CheckDBMemo }
{$ENDIF}

{---- Internal Routines (No Dialog) ----}

function  TSpellDlg.OpenDictionary: Boolean;
  {-opens the dictionary; returns TRUE if successful}
begin
  if DictionaryName='' then
    DictionaryName := UpperCase (Dictionaries[DictionaryType] + DictExt);
  DictionaryPath := UpperCase (DictionaryPath);
  if DictionaryPath = 'APPLICATIONPATH' then
    DictionaryPath := ExtractFilePath (Application.ExeName)
  else
  if Length (DictionaryPath)>0 then
    if DictionaryPath[Length(DictionaryPath)]<>'\' then
      DictionaryPath := DictionaryPath + '\';
  Result := dllOpenDictionary (DictionaryPath + DictionaryName);
  if not Result then
    {try again for DLL load}
    Result := dllOpenDictionary (DictionaryPath + DictionaryName);
end;  { TSpellDlg.OpenDictionary }

procedure TSpellDlg.CloseDictionary;
  {-closes the dictionary}
begin
  dllCloseDictionary;
end;  { TSpellDlg.CloseDictionary }

function TSpellDlg.InDictionary (AWord: String): Boolean;
  {-checks to see if the word is in the dictionary (no dialog)}
begin
  Result := dllInDictionary (AWord);
end;  { TSpellDlg.InDictionary }

function TSpellDlg.SuggestWords (AWord: String; NumToList: Byte): TStringList;
  {-suggests words}
begin
  Result := dllSuggestWords (AWord, NumToList);
end;  { TSpellDlg.SuggestWords }

procedure Register;
begin
  RegisterComponents('Dialogs', [TSpellDlg]);
end;  { Register }

end.  { EDSSpell }